PlantsManagement.f90

Implement forest management practices
Source Code

!! Implement forest management practices
!|author:  <a href="mailto:giovanni.ravazzani@polimi.it">Giovanni Ravazzani</a>
! license: <a href="http://www.gnu.org/licenses/">GPL</a>
!    
!### History
!
! current version  1.0 - 24th January 2020   
!
! | version  |  date       |  comment |
! |----------|-------------|----------|
! | 1.0      | 24/Jan/2020 | Original code |
!
!### License  
! license: GNU GPL <http://www.gnu.org/licenses/>
!
!### Module Description 
! Routines to manage forest (silvocoltural practices)
!  
MODULE PlantsManagement

! 
! Modules used:

USE DataTypeSizes, ONLY : &
   ! Imported Type Definitions:
   short, long, float

USE LogLib, ONLY: &
   !Imported routines:
   Catch

USE IniLib, ONLY : &
    !Imported derived types:
    IniList, &
    !Imported routines:
    IniOpen, IniClose , &
    SectionIsPresent, KeyIsPresent, &
    IniReadInt , IniReadReal , &
    GetNofSubSections, IniReadString

USE GridLib, ONLY: &
    !imported definitions:
    grid_integer !, &
    !imported routines:
    !NewGrid

USE GridOperations, ONLY : &
   !imported routines:
   GridByIni

USE GridStatistics, ONLY: &
    !imported routines:
    UniqueValues

USE StringManipulation, ONLY: &
    !imported routines:
    ToString

USE Chronos , ONLY: &
    !imported definitions:
    DateTime, &
    !imported variables:
    timeString, &
    !Imported operands:
    OPERATOR ( - ), &
    OPERATOR ( + ), &
    ASSIGNMENT( = )

USE Units, ONLY: &
    !imported parameters:
    year

IMPLICIT NONE

!global variables
LOGICAL :: plants_management
TYPE (grid_integer) :: management_map

!global routines:
PUBLIC :: SetPlantsManagement
PUBLIC :: ApplyPlantsManagement
PUBLIC :: SetPractice


TYPE :: thinning
    TYPE (DateTime) :: time !when plants are cut
    REAL (KIND = float) :: intensity !percentage of plants to be cut
    !used for reforestation
    LOGICAL :: reforestation !true if reforestation is required
    INTEGER (KIND = short) :: species !species for reforestation
    REAL (KIND = float) :: density ! number of plants per hectar
    REAL (KIND = float) :: age !(years)
    REAL (KIND = float) :: dbh ! stem diameter at breast height (cm)
    REAL (KIND = float) :: height !tree height (m)
    REAL (KIND = float) :: stem_biomass !(t/ha)
    REAL (KIND = float) :: root_biomass !(t/ha)
    REAL (KIND = float) :: leaf_biomass !(t/ha)
    REAL (KIND = float) :: lai ! leaf area index (m2/m2)
END TYPE thinning

TYPE :: Practice
    INTEGER (KIND = short) :: id
    TYPE (Thinning), ALLOCATABLE :: cuts (:)
    INTEGER (KIND = short) :: current
    TYPE (DateTime) :: next
END TYPE Practice


!local declarations:

TYPE (Practice), PRIVATE, ALLOCATABLE :: practices (:)


PRIVATE :: GetPos

!=======
    CONTAINS
!=======

    



!==============================================================================
!| Description:
!  Set variables and options to manage plants. Basically two options are 
!  available:
!
! 1. Regular thinning time interval and  intensity. The percentage of plants 
!     is removed every time interval.
! 2. Specific dates when applying a given thinning intensity
!
!  A different option can be specified for each stand (cell).
!
SUBROUTINE  SetPlantsManagement &
!
(file, begin, end )

IMPLICIT NONE

!arguments with intent(in):
CHARACTER (LEN = *), INTENT(IN) :: file !! file to configure plants management
TYPE (DateTime), INTENT (IN) :: begin !!simulation starting date
TYPE (DateTime), INTENT(IN) :: end !!simulation ending date

!local declarations:
TYPE(IniList) :: iniDB !!store configuration info
INTEGER (KIND = short) :: i, j
INTEGER (KIND = short), ALLOCATABLE :: uniques (:)
INTEGER (KIND = short), ALLOCATABLE :: active_practices (:)
INTEGER (KIND = short) :: count_practices
INTEGER (KIND = short) :: cuts !!number of cuts 
INTEGER (KIND = short) :: interval !!thinning interval (years)
!---------------------------------------end of declarations--------------------

!load options
CALL IniOpen (file, iniDB)

!set management map
IF ( SectionIsPresent ( 'practice-map', iniDB)  ) THEN
    CALL GridByIni (iniDB, management_map, section = 'practice-map')
    
ELSE
    CALL Catch ('error', 'PlantsManagement', 'practice-map missing in configuration file')
END IF

!find unique values in management_map
CALL UniqueValues (management_map, uniques)

!search active management practices 
count_practices = 0
DO i = 1, SIZE (uniques)
    IF ( SectionIsPresent ( ToString (uniques(i)), iniDB ) ) THEN
        count_practices = count_practices + 1
    ELSE
        CALL Catch ('warning', 'PlantsManagement', 'section ' // TRIM (ToString (uniques(i)) ) // ' has no management associated' )
    END IF
END DO

ALLOCATE ( active_practices ( count_practices) )

j = 0
DO i = 1, SIZE (uniques)
    IF ( SectionIsPresent ( ToString (uniques(i)), iniDB ) ) THEN
        j = j + 1
        active_practices (j) = uniques (i)
    END IF
END DO


ALLOCATE ( practices ( (count_practices) ) )

DO i = 1, count_practices
    
    !set id
    practices (i) % id = active_practices (i)
    !check if regular interval thinning is required
    IF ( KeyIsPresent (key = 'thinning-interval', iniDB = iniDB, &
            section = ToString (active_practices(i)) ) ) THEN
             
        interval = IniReadInt  ( 'thinning-interval', iniDB, section = ToString (active_practices(i))  )
             
        !compute how many cuts to do
        cuts = (end - begin) / year / interval
             
        ALLOCATE (   practices (i) % cuts (cuts)   )
             
        DO j = 1, cuts
                 
            !set date and time of thinning
            practices (i) % cuts (j) % time = begin  + INT( j * interval * year)
                 
            !set percentage of thinning
            practices (i) % cuts (j) % intensity = IniReadReal &
                ( 'thinning-intensity', iniDB, section = ToString (active_practices(i)) )
                 
            !detect clear-cutting and reforestation
            IF ( practices (i) % cuts (j) % intensity == 100. ) THEN 
                practices (i) % cuts (j) % reforestation = .TRUE.
                !read parameters for reforestation
                practices (i) % cuts (j) % species = &
                    IniReadInt ( 'species', iniDB, section = ToString (active_practices(i)) )
                practices (i) % cuts (j) % density = &
                    IniReadReal ( 'density', iniDB, section = ToString (active_practices(i)) )
                practices (i) % cuts (j) % age = &
                    IniReadReal ( 'age', iniDB, section = ToString (active_practices(i)) )
                practices (i) % cuts (j) % dbh = &
                    IniReadReal ( 'dbh', iniDB, section = ToString (active_practices(i)) )
                practices (i) % cuts (j) % height = &
                    IniReadReal ( 'height', iniDB, section = ToString (active_practices(i)) )
                practices (i) % cuts (j) % stem_biomass = &
                    IniReadReal ( 'stem-biomass', iniDB, section = ToString (active_practices(i)) )
                practices (i) % cuts (j) % root_biomass = &
                    IniReadReal ( 'root-biomass', iniDB, section = ToString (active_practices(i)) )
                practices (i) % cuts (j) % leaf_biomass = &
                    IniReadReal ( 'leaf-biomass', iniDB, section = ToString (active_practices(i)) )
                practices (i) % cuts (j) % lai = &
                    IniReadReal ( 'lai', iniDB, section = ToString (active_practices(i)) )
                      
            ELSE
                practices (i) % cuts (j) % reforestation = .FALSE.
            END IF
                                
                 
        END DO
        
        !set time for next cut
        practices (i) % next = practices (i) % cuts (1) % time
        practices (i) % current = 0
            

    ELSE ! thinning at given dates
            cuts = GetNofSubSections ( ini = iniDB, sectionname = ToString (active_practices(i)) )
            
            ALLOCATE (   practices (i) % cuts (cuts)   )
            
            DO j = 1, cuts
                
                !set date and time of thinning
                timeString = IniReadString &
                        ( 'date', iniDB, section = ToString (active_practices(i)), subsection = 'cut' // ToString (j) ) 
                
                timeString (11:) = 'T00:00:00+00:00'
                practices (i) % cuts (j) % time = timeString
                 
                !set percentage of thinning
                    practices (i) % cuts (j) % intensity = IniReadReal &
                        ( 'thinning-intensity', iniDB, section = ToString (active_practices(i)), subsection = 'cut' // ToString (j) )
                 
                    !detect clear-cutting and reforestation
                    IF ( practices (i) % cuts (j) % intensity == 100. ) THEN 
                        practices (i) % cuts (j) % reforestation = .TRUE.
                        !read parameters for reforestation
                        practices (i) % cuts (j) % species = &
                            IniReadInt ( 'species', iniDB, section = ToString (active_practices(i)), subsection = 'cut' // ToString (j) )
                        practices (i) % cuts (j) % density = &
                            IniReadReal ( 'density', iniDB, section = ToString (active_practices(i)), subsection = 'cut' // ToString (j) )
                        practices (i) % cuts (j) % age = &
                            IniReadReal ( 'age', iniDB, section = ToString (active_practices(i)), subsection = 'cut' // ToString (j) )
                        practices (i) % cuts (j) % dbh = &
                            IniReadReal ( 'dbh', iniDB, section = ToString (active_practices(i)), subsection = 'cut' // ToString (j) )
                        practices (i) % cuts (j) % height = &
                            IniReadReal ( 'height', iniDB, section = ToString (active_practices(i)), subsection = 'cut' // ToString (j) )
                        practices (i) % cuts (j) % stem_biomass = &
                            IniReadReal ( 'stem-biomass', iniDB, section = ToString (active_practices(i)), subsection = 'cut' // ToString (j) )
                        practices (i) % cuts (j) % root_biomass = &
                            IniReadReal ( 'root-biomass', iniDB, section = ToString (active_practices(i)), subsection = 'cut' // ToString (j) )
                        practices (i) % cuts (j) % leaf_biomass = &
                            IniReadReal ( 'leaf-biomass', iniDB, section = ToString (active_practices(i)), subsection = 'cut' // ToString (j) )
                        practices (i) % cuts (j) % lai = &
                            IniReadReal ( 'lai', iniDB, section = ToString (active_practices(i)), subsection = 'cut' // ToString (j) )
                      
                    ELSE
                        practices (i) % cuts (j) % reforestation = .FALSE.
                    END IF
                              
            END DO    
            
            !set time for next cut
            practices (i) % next = practices (i) % cuts (1) % time
            practices (i) % current = 0
                 
    END IF
         
 
END DO


!freememory
DEALLOCATE ( uniques )
DEALLOCATE ( active_practices )

!close option file
CALL IniClose (iniDB)

RETURN
END SUBROUTINE SetPlantsManagement



!==============================================================================
!| Description:
!  Set variables and options to manage plants. Basically two options are 
!  available:
!
! 1. Regular thinning time interval and  intensity. The percentage of plants 
!     is removed every time interval.
!
! 2. specific dates when applying a given thinning intensity
!
!  A different option can be specified for each stand (cell).
!
SUBROUTINE  ApplyPlantsManagement &
!
(time, pract, density, root, stem, leaf, total, lai, cover, age, height, dbh, stem_yield)


IMPLICIT NONE

!arguments with intent(in):
TYPE (DateTime), INTENT(IN) :: time

!arguments with intent(inout) ::
TYPE (Practice)    , INTENT (INOUT) :: pract
REAL (KIND = float), INTENT (INOUT) :: density
REAL (KIND = float), INTENT (INOUT) :: root
REAL (KIND = float), INTENT (INOUT) :: stem
REAL (KIND = float), INTENT (INOUT) :: leaf
REAL (KIND = float), INTENT (INOUT) :: total
REAL (KIND = float), INTENT (INOUT) :: lai
REAL (KIND = float), INTENT (INOUT) :: cover
REAL (KIND = float), INTENT (INOUT) :: age
REAL (KIND = float), INTENT (INOUT) :: height
REAL (KIND = float), INTENT (INOUT) :: dbh

!arguments with intent(out) ::
REAL (KIND = float), INTENT (OUT) :: stem_yield

!local declarations:
INTEGER (KIND = short) :: pos
INTEGER (KIND = short) :: ncut
REAL (KIND = float)    :: stem_before
!------------------------end of declarations-----------------------------------

ncut = pract % current

stem_before = stem
    
IF ( pract % cuts (ncut) % reforestation) THEN
      stem_yield = stem_before
      density =   pract % cuts (ncut) % density 
      root    =   pract % cuts (ncut) % root_biomass 
      stem    =   pract % cuts (ncut) % stem_biomass
      leaf    =   pract % cuts (ncut) % leaf_biomass
      total   =   root + stem + leaf
      lai     =   pract % cuts (ncut) % lai
      age     =   pract % cuts (ncut) % age 
      height  =   pract % cuts (ncut) % height 
      dbh     =   pract % cuts (ncut) % dbh 
      !  density = 700  # number of plants per hectar
      !age = 5  #(years)
      !dbh = 8. # # stem diameter at breast height (cm)
      !height = 3. # #tree height (m)
      !stem-biomass = 200. #(t/ha)
      !root-biomass = 64. #(t/ha)
      !leaf-biomass = 15. #(t/ha)
      !lai = 2.  #leaf area index (m2/m2)
    
ELSE !no clear cutting, update biomass
    density = density * ( 1. - pract % cuts (ncut) % intensity / 100. )
    root    = root * ( 1. - pract % cuts (ncut) % intensity / 100. )
    stem    = stem * ( 1. - pract % cuts (ncut) % intensity / 100. )
    leaf    = leaf * ( 1. - pract % cuts (ncut) % intensity / 100. )
    total   = total * ( 1. - pract % cuts (ncut) % intensity / 100. )
    lai     = lai * ( 1. - pract % cuts (ncut) % intensity / 100. )
    cover   = cover * ( 1. - pract % cuts (ncut) % intensity / 100. )
    stem_yield = stem_before - stem
END IF    
    


RETURN
END SUBROUTINE ApplyPlantsManagement


!==============================================================================
!| Description:
!  return the position in practices array given practice id 
FUNCTION GetPos &
!
(id) &
!
RESULT (pos)

IMPLICIT NONE

!arguments with intent(in):
INTEGER (KIND = long), INTENT(IN) :: id

!local declarations:
INTEGER (KIND = long) :: pos
INTEGER (KIND = short) :: i

!---------------------------------end of declarations--------------------------

pos = 0
DO i = 1, SIZE (practices)
    IF ( practices (i) % id == id) THEN
        pos = i
        EXIT
    END IF
    
END DO


RETURN
END FUNCTION GetPos


!==============================================================================
!| Description:
!  Set management practices to single plant stand
!
SUBROUTINE  SetPractice &
!
(id, pract)

IMPLICIT NONE

!arguments with intent (in):
INTEGER (KIND = long), INTENT(IN) :: id

!arguments with intent (inout):
TYPE (Practice), INTENT(INOUT) :: pract

!local declarations:
INTEGER (KIND = long) :: pos

!------------------------------------------end of declarations-----------------

pos = GetPos (id)

IF (pos == 0) THEN
  RETURN !no prcatice to apply
ELSE
   pract = practices (pos)
END IF



RETURN
END SUBROUTINE SetPractice

END MODULE PlantsManagement
PlantsManagement.f90 Source File

Contents

Modules

Source Code

Source Code
